(SETQ IBASE (ADD1 7)) 


(DEFPROP LISPDP 
 (NIL DISPINIT FRM FRMOUT EDD %DPSPRINT DPOUT DRAW) 
VALUE)

(DEFPROP DISPINIT 
 (LAMBDA NIL
  (PROG NIL
	(GETSYM SUBR
 		AIVECT
 		AVECT
 		APT
 		RIVECT
 		RVECT
 		RPT
 		DTYOS
 		DTYOU
 		LOCATE
 		CLEAR
 		FIXUP
 		DJUMP
 		DJSR
 		DPINIT
 		SHOW
 		KILL
 		GVECT
 		CHINIT)
	(DPINIT -540 5001)
	(AIVECT -1000 1000)
	(SHOW 0)
	(CHINIT 2 105 -1000)
	(CLEAR))) 
EXPR)

(DEFPROP FRM 
 (LAMBDA(%%A)
  (PROG (N)
	(CLEAR)
	(SETQ N (GET %%A (QUOTE FRM)))
	(GVECT 0 0 46 (CADR N) 0)
	(SHOW (CAR N))
	(CHINIT (CADR N) (CADDR N) (CADDDR N))
	(RETURN (CAR N)))) 
EXPR)

(DEFPROP FRMOUT 
 (LAMBDA(DP%L)
  (PROG (DP%N)
	(CLEAR)
	(SETQ DP%N (FRM (CAR DP%L)))
	(DTYOS)
	(MAPC (FUNCTION EVAL) (CDR DP%L))
	(DTYOU)
	(KILL DP%N)
	(SHOW DP%N)
	(CLEAR))) 
FEXPR)

(DEFPROP EDD 
 (LAMBDA NIL (PROG NIL (KILL 11) (ED) (KILL 7))) 
EXPR)

(DEFPROP %DPSPRINT 
 (LAMBDA(X)
  (PROG NIL
	(DEFPROP ED (7 1 160 -1000) FRM)
	(PUTPROP (QUOTE %%DPSPRINT) (GET (QUOTE %DPSPRINT) (QUOTE SUBR)) (QUOTE SUBR))
	(FRMOUT ED
		(COND ((EQ (CAR X) (QUOTE DEFPROP)) (PRINC (QUOTE "
("))						    (PRIN1 (CAR X))
						    (PRINC (QUOTE " "))
						    (PRIN1 (CADR X))
						    (TERPRI)
						    (%%DPSPRINT (CADDR X))
						    (PRIN1 (CADDDR X))
						    (PRINC (QUOTE ")
")))		      (T (%%DPSPRINT X)))))) 
EXPR)

(DEFPROP DPOUT 
 (LAMBDA(L)
  (PROG NIL (CLEAR) (DTYOS) (MAPC (FUNCTION EVAL) (CDR L)) (DTYOU) (KILL (CAR L)) (SHOW (CAR L)) (CLEAR))) 
FEXPR)

(DEFPROP DRAW 
 (LAMBDA (L) (MAPC (FUNCTION (LAMBDA (X) (RVECT (CAR X) (CADR X)))) L)) 
EXPR)